home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / dbase / scion409.lha / Scion409 / ScionARexx.lha / Tafel.rexx < prev    next >
OS/2 REXX Batch file  |  1993-10-25  |  5KB  |  199 lines
  1. /****************************************************************************/
  2. /*                                                                          */
  3. /*                            Tafel.rexx                                    */
  4. /*                                                                          */
  5. /* Written by: Peter Billing, RMB 1240, Yinnar 3869, Australia              */
  6. /*                                                                          */
  7. /* Last saved: Wednesday 29-Sep-93                                          */
  8. /*                                                                          */
  9. /* This program should show the Ancestors of a person in the SCION database.*/
  10. /* The database must be running for this AREXX script to work.              */
  11. /*                                                                          */
  12. /****************************************************************************/
  13.  
  14. /* Return the Database Name */
  15.  
  16. options results
  17. /*test = show('P','SCIONGEN')
  18. if test = 0  then
  19. say
  20. say "I am sorry to say that the SCION Genealogist database is not available."
  21. say "Please start the SCION program BEFORE using this script."
  22. say
  23. exit */
  24.  
  25. myport = "SCIONGEN"
  26. address value myport
  27. getdbname
  28. database = upper(result)
  29. heading = "Tafel listing of a person in the" database "database on" date()
  30. output = "STDOUT"
  31. code1 = "" /* Bold */
  32. code2 = "" /* Normal */
  33. writeln(output, " ")
  34. writeln(output,center("This script will give you a",80))
  35. writeln(output,center(heading,80))
  36.  
  37. writech(output, "Type in the IRN of the person you want ")
  38. pull IRN
  39. say
  40. call MakeName(irn)
  41. person = name
  42.  
  43. writech(output, "You have asked about "code1 person code2"is this correct? Yes/No ")
  44. pull answer
  45. say
  46. answer = left(answer,1)
  47.  if upper(answer) = "N"
  48.  then exit
  49.  
  50. writech(output, "How many Generations do you want displayed? 1-12 ")
  51. pull generations
  52. say
  53. if generations > 12 then
  54. exit
  55.  
  56. say center("The output to screen may have some place names cut short",80)
  57. say center("but the file output will contain the full names.",80)
  58. writech(output,"Output to Screen or File. No formfeeds are in file. S/F ")
  59. pull out
  60. if out = "" then out = "S"
  61. say
  62. output = "STDOUT"
  63.  
  64. if out = "F" then do
  65.    code1 = ""  /* Bold on */
  66.    code2 = "" /* Bold off */
  67.    filename = "RAM:Tafel_"word(person,1)"_"word(person,words(person))".Scion"
  68.    open(w_file,filename,"w")
  69.    output = w_file
  70.    writeln(stdout,"")
  71.    writeln(stdout,"Writing file to" filename)
  72.    end
  73.  
  74.  
  75. generations = generations-1
  76. personnumber=1
  77.  
  78. writeln(output, center("Parents of" person,80))
  79. writeln(output, center("--------------------------------------------------------",80))
  80. j=1
  81. Parents(irn)
  82. irn.j = irn.a
  83. j = j + 1
  84. irn.j = irn.b
  85. if generations = 0
  86.   then exit
  87. x = 1
  88. Great = 2
  89. do c = 1 to generations
  90. /* personnumber=0 */
  91. j = x*2+1 /* This increases j */
  92. writeln(output, center(Great "generation of Ancestors of" person,80))
  93. writeln(output, center("--------------------------------------------------------",80))
  94. do i = x to x*2
  95. Parents(irn.i)
  96. irn.j = irn.a
  97. j = j + 1
  98. irn.j = irn.b
  99. j = j + 1
  100. end
  101. x = i
  102. Great = Great + 1
  103. end
  104. exit
  105.  
  106. MakeName:
  107. parse arg irn
  108. getfirstname irn
  109. name = result
  110. getlastname irn
  111. name = name result
  112. return name
  113.  
  114. AddCodes:
  115. parse arg irn
  116. getfirstname irn
  117. name = left(result,16)
  118. getlastname irn
  119. name = name code1 left(result,12)code2
  120. return name
  121.  
  122.  
  123.  
  124. Parents:
  125. parse arg irn
  126.  
  127. getparents irn
  128. fgrn = result
  129.  
  130. getprincipal fgrn
  131. irn.a = result
  132. MakeName(result)
  133. personnumber= personnumber+1
  134. if out = "S" then do
  135.   len = 25
  136.   end
  137.   else
  138.   len = 40
  139.  
  140. birth = ""
  141. death = ""
  142. marrydate = ""
  143. birthplace = ""
  144. deathplace = ""
  145. marryplace = ""
  146. if length(name) > 1 then do
  147. AddCodes(irn.a)
  148. father = name
  149. getbirthdate irn.a
  150. birth = result
  151. getbirthplace irn.a
  152. birthplace = substr(result,1,len)
  153. getdeathdate irn.a
  154. death = result
  155. getdeathplace irn.a
  156. deathplace = substr(result,1,len)
  157. getmarrydate fgrn
  158. marrydate = result
  159. getmarryplace fgrn
  160. marryplace = substr(result,1,len)
  161. writeln(output, right(personnumber,4)"  "name "Born: "left(birth,14) birthplace)
  162. if length(death) > 1 then do
  163. writeln(output, right("   Died:",42) left(death,14) deathplace)
  164. end
  165. if length(marrydate) > 1 then do
  166. writeln(output, right("Married:",42) left(marrydate,14) marryplace)
  167. end
  168. end
  169.  
  170. getspouse fgrn
  171. irn.b = result
  172. MakeName(result)
  173. personnumber= personnumber+1
  174. birth = ""
  175. death = ""
  176. marrydate = ""
  177. birthplace = ""
  178. deathplace = ""
  179.  
  180. if length(name) > 1 then do
  181. AddCodes(irn.b)
  182. mother = name
  183. getbirthdate irn.b
  184. birth = result
  185. getbirthplace irn.b
  186. birthplace = substr(result,1,len)
  187. getdeathdate irn.b
  188. death = result
  189. getdeathplace irn.b
  190. deathplace = substr(result,1,len)
  191. writeln(output, right(personnumber,4)"  "name "Born: "left(birth,14) birthplace)
  192. if length(death) > 1 then do
  193. writeln(output, right("   Died:",42) left(death,14) deathplace)
  194. end
  195. writeln(output,"")
  196. end
  197. return irn.a irn.b
  198.  
  199.